The CICA Windows Explosion!/The CICA Windows Explosion! - Disc 1.iso/desktop/gv21.zip/GV.FRM

Text File | 1995-04-03 | 56KB | 1,950 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "Graphics Viewer"
   ClientHeight    =   6795
   ClientLeft      =   105
   ClientTop       =   360
   ClientWidth     =   9525
   ClipControls    =   0   'False
   ForeColor       =   &H00000000&
   Height          =   7200
   Left            =   45
   LinkTopic       =   "Form1"
   ScaleHeight     =   453
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   635
   Top             =   15
   Width           =   9645
   Begin Frame Frm_JPEG
      Caption         =   "JPEG Options"
      Height          =   2055
      Left            =   2640
      TabIndex        =   22
      Top             =   4320
      Visible         =   0   'False
      Width           =   5175
      Begin CheckBox Chk_TPQ
         Caption         =   "Two-Pass Quantize"
         Height          =   255
         Left            =   2640
         TabIndex        =   32
         Top             =   360
         Width           =   2295
      End
      Begin CheckBox Chk_Do_Fancy
         Caption         =   "Do Fancy Upsampling"
         Height          =   255
         Left            =   120
         TabIndex        =   31
         Top             =   360
         Width           =   2295
      End
      Begin Frame Frm_DCT
         Caption         =   "DCT Method"
         Height          =   1215
         Left            =   2640
         TabIndex        =   24
         Top             =   600
         Width           =   2295
         Begin OptionButton Opt_DCT
            Caption         =   "Floating Point"
            Height          =   255
            Index           =   2
            Left            =   120
            TabIndex        =   30
            Top             =   840
            Width           =   1935
         End
         Begin OptionButton Opt_DCT
            Caption         =   "Fast Integer"
            Height          =   255
            Index           =   1
            Left            =   120
            TabIndex        =   29
            Top             =   600
            Value           =   -1  'True
            Width           =   1935
         End
         Begin OptionButton Opt_DCT
            Caption         =   "Slow Integer"
            Height          =   255
            Index           =   0
            Left            =   120
            TabIndex        =   28
            Top             =   360
            Width           =   1935
         End
      End
      Begin Frame Frm_Dither
         Caption         =   "Dithering Options"
         Height          =   1215
         Left            =   120
         TabIndex        =   23
         Top             =   600
         Width           =   2295
         Begin OptionButton Opt_JPEGDither
            Caption         =   "Floyd-Steinberg"
            Height          =   255
            Index           =   2
            Left            =   120
            TabIndex        =   27
            Top             =   840
            Width           =   1815
         End
         Begin OptionButton Opt_JPEGDither
            Caption         =   "Ordered"
            Height          =   255
            Index           =   1
            Left            =   120
            TabIndex        =   26
            Top             =   600
            Value           =   -1  'True
            Width           =   1575
         End
         Begin OptionButton Opt_JPEGDither
            Caption         =   "None"
            Height          =   255
            Index           =   0
            Left            =   120
            TabIndex        =   25
            Top             =   360
            Width           =   1575
         End
      End
   End
   Begin Frame Frame1
      Height          =   6615
      Left            =   120
      TabIndex        =   7
      Top             =   0
      Width           =   2175
      Begin OptionButton Opt_Dither
         Caption         =   "No Dithering"
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   21
         Top             =   3960
         Value           =   -1  'True
         Width           =   1935
      End
      Begin OptionButton Opt_Dither
         Caption         =   "Dither extra colors"
         Height          =   255
         Index           =   2
         Left            =   120
         TabIndex        =   20
         Top             =   4440
         Width           =   1935
      End
      Begin OptionButton Opt_Dither
         Caption         =   "Dither always"
         Height          =   255
         Index           =   1
         Left            =   120
         TabIndex        =   19
         Top             =   4200
         Width           =   1935
      End
      Begin Frame Frame2
         Caption         =   "Scale"
         Height          =   855
         Left            =   120
         TabIndex        =   14
         Top             =   4680
         Width           =   1935
         Begin OptionButton Opt_Scale
            Caption         =   "400%"
            Height          =   255
            Index           =   3
            Left            =   1080
            TabIndex        =   18
            Top             =   480
            Width           =   735
         End
         Begin OptionButton Opt_Scale
            Caption         =   "300%"
            Height          =   255
            Index           =   2
            Left            =   1080
            TabIndex        =   17
            Top             =   240
            Width           =   735
         End
         Begin OptionButton Opt_Scale
            Caption         =   "200%"
            Height          =   255
            Index           =   1
            Left            =   120
            TabIndex        =   16
            Top             =   480
            Width           =   735
         End
         Begin OptionButton Opt_Scale
            Caption         =   "100%"
            Height          =   255
            Index           =   0
            Left            =   120
            TabIndex        =   15
            Top             =   240
            Value           =   -1  'True
            Width           =   735
         End
      End
      Begin CommandButton Cmd_Disp
         Caption         =   "Print"
         Height          =   375
         Index           =   1
         Left            =   1200
         TabIndex        =   13
         Top             =   5640
         Width           =   855
      End
      Begin CommandButton Cmd_Info
         Caption         =   "Info"
         Height          =   375
         Left            =   120
         TabIndex        =   12
         Top             =   5640
         Width           =   855
      End
      Begin FileListBox File1
         Height          =   2175
         Left            =   120
         Pattern         =   "*.bmp;*.tif;*.gif;*.wpg;*.pcx;*.pic;*.tga;*.msp;*.iff;*.lbm;*.mac;*.gem;*.img;*.cut;*.dib;*.rle;*.wmf;*.jpg;*.ras;*.art;*.hrz"
         TabIndex        =   11
         Top             =   1680
         Width           =   1935
      End
      Begin DirListBox Dir1
         Height          =   930
         Left            =   120
         TabIndex        =   10
         Top             =   480
         Width           =   1935
      End
      Begin CommandButton Cmd_Disp
         Caption         =   "Display"
         Height          =   375
         Index           =   0
         Left            =   120
         TabIndex        =   9
         Top             =   6120
         Width           =   855
      End
      Begin CommandButton Cmd_Exit
         Caption         =   "Exit"
         Height          =   375
         Left            =   1200
         TabIndex        =   8
         Top             =   6120
         Width           =   855
      End
      Begin Label Label1
         Caption         =   "&Directories"
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   0
         Top             =   240
         Width           =   1095
      End
      Begin Label Label1
         Caption         =   "&Files"
         Height          =   255
         Index           =   1
         Left            =   120
         TabIndex        =   1
         Top             =   1440
         Width           =   1095
      End
   End
   Begin PictureBox Picture2
      BackColor       =   &H00C0C0C0&
      Height          =   255
      Left            =   9240
      ScaleHeight     =   225
      ScaleWidth      =   225
      TabIndex        =   6
      Top             =   6600
      Visible         =   0   'False
      Width           =   255
   End
   Begin VScrollBar VScroll1
      Height          =   6615
      LargeChange     =   100
      Left            =   9240
      SmallChange     =   20
      TabIndex        =   5
      Top             =   0
      Visible         =   0   'False
      Width           =   255
   End
   Begin HScrollBar HScroll1
      Height          =   255
      LargeChange     =   100
      Left            =   0
      SmallChange     =   20
      TabIndex        =   4
      Top             =   6600
      Visible         =   0   'False
      Width           =   9255
   End
   Begin PictureBox Pic_Graphic
      Height          =   3135
      Left            =   0
      ScaleHeight     =   207
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   287
      TabIndex        =   3
      Top             =   0
      Visible         =   0   'False
      Width           =   4335
   End
   Begin ListBox Lst_Info
      Height          =   6465
      Left            =   2400
      TabIndex        =   2
      Top             =   120
      Visible         =   0   'False
      Width           =   6975
   End
   Begin Menu Mnu_Close
      Caption         =   "&Close"
      Visible         =   0   'False
   End
End
Option Explicit
DefInt A-Z
Dim Fi%, File$
Dim Ret%
Dim IntMot%
Dim Tags$(254 To 532)
Dim Typs$(4)
Dim Errors$(-13 To -1)
Dim PX%, PY%
Dim dhDC%, dhWnd%
Dim Dither%, Prn%, Scle%
Dim BT As String * 1
Dim Canc%, Found_BMP%, BMPhndl%

Sub Cmd_Disp_Click (Index As Integer)
    On Error GoTo Er_hndl:

    Dim A$, HL&, I%, Ret%, DM%, DCTM%
    Dim Wdth%, Hght%, Lft%, Tp%
    Dim hMF%, Buffer&, gptr&
    Dim TempDC%, hDCprev%, SavDC%
    Dim WMFH As METAFILEHEADER

    If File1.ListIndex < 0 Then Beep: Exit Sub
    Frm_JPEG.Visible = False
    Screen.MousePointer = 11
    File$ = Dir1.Path & "\" & File1.List(File1.ListIndex)
    A$ = Right$(File$, 3)
    Found_BMP = False
    If Index = 0 Then
    Frame1.Visible = False
    Lst_Info.Visible = False
    Ret = DoEvents()
    Pic_Graphic.Cls

    Pic_Graphic.AutoRedraw = False
    dhDC = Pic_Graphic.hDC
    dhWnd = Pic_Graphic.hWnd
    Prn = False
    Else
    Printer.Print " "
    dhDC = Printer.hDC
    dhWnd = 0
    Prn = True
    End If
    For I = 0 To 3
    If Opt_Scale(I).Value Then Scle = I + 1
    Next I
    For I = 0 To 2
    If Opt_Dither(I).Value Then Dither = I
    Next I

    Select Case A$
    Case "art"
    BMPhndl = ReadART(File$, dhDC, dhWnd, Prn, 0, 0, Scle)

    Case "bmp"
    BMPhndl = ReadBMP(File$, dhDC, dhWnd, Dither, Prn, 0, 0, Scle)

    Case "cut"
    BMPhndl = ReadCUT(File$, dhDC, dhWnd, Dither, Prn, 0, 0, Scle)

    Case "dib"
    BMPhndl = ReadBMP(File$, dhDC, dhWnd, Dither, Prn, 0, 0, Scle)

    Case "gem"
    BMPhndl = ReadIMG(File$, dhDC, dhWnd, Dither, Prn, 0, 0, Scle)

    Case "gif"
    Disp_GIF
    If BMPhndl > 0 And Prn = False Then Exit Sub

    Case "hrz"
    BMPhndl = ReadHRZ(File$, dhDC, dhWnd, Dither, Prn, 0, 0, Scle)

    Case "iff"
    BMPhndl = ReadIFF(File$, dhDC, dhWnd, Dither, Prn, 0, 0, Scle)

    Case "img"
    BMPhndl = ReadIMG(File$, dhDC, dhWnd, Dither, Prn, 0, 0, Scle)

    Case "jpg"
    For I = 0 To 2
        If Opt_JPEGDither(I).Value Then DM = I
        If Opt_DCT(I).Value Then DCTM = I
    Next I
    BMPhndl = ReadJPG(File$, dhDC, dhWnd, Dither, Prn, 0, 0, Scle, Chk_Do_Fancy.Value, Chk_TPQ.Value, DM, DCTM)

    Case "lbm"
    BMPhndl = ReadIFF(File$, dhDC, dhWnd, Dither, Prn, 0, 0, Scle)

    Case "mac"
    BMPhndl = ReadMAC(File$, dhDC, dhWnd, Prn, 0, 0, Scle)

    Case "msp"
    BMPhndl = ReadMSP(File$, dhDC, dhWnd, Prn, 0, 0, Scle)

    Case "pcx"
    BMPhndl = ReadPCX(File$, dhDC, dhWnd, Dither, Prn, 0, 0, Scle)

    Case "pic"
    BMPhndl = ReadPIC(File$, dhDC, dhWnd, Dither, Prn, 0, 0, Scle)

    Case "ras"
    BMPhndl = ReadRAS(File$, dhDC, dhWnd, Dither, Prn, 0, 0, Scle)

    Case "rle"
    BMPhndl = ReadBMP(File$, dhDC, dhWnd, Dither, Prn, 0, 0, Scle)

    Case "tga"
    BMPhndl = ReadTGA(File$, dhDC, dhWnd, Dither, Prn, 0, 0, Scle)

    Case "tif"
    BMPhndl = ReadTIF(File$, dhDC, dhWnd, Dither, Prn, 0, 0, Scle)

    Case "wmf"
    If Index = 0 Then
        Pic_Graphic.AutoSize = True
        Pic_Graphic.Picture = LoadPicture(File$)
        BMPhndl = 0
        Pic_Graphic.AutoSize = False
    Else
        Printer.ScaleMode = 3
        SavDC = SaveDC(Printer.hDC)
        Fi = FreeFile
        Open File$ For Binary As #Fi
        Get #Fi, , WMFH
        If WMFH.key = &H9AC6CDD7 Then
        Wdth = ((WMFH.bbox.right - WMFH.bbox.Left) / WMFH.inch) * (1440 / Printer.TwipsPerPixelX)
        Hght = ((WMFH.bbox.Bottom - WMFH.bbox.Top) / WMFH.inch) * (1440 / Printer.TwipsPerPixelY)
        Buffer = LOF(Fi) - 22
        hMF = GlobalAlloc(GMEM_MOVEABLE, Buffer)
        If hMF <> 0 Then
            gptr = GlobalLock(hMF)
            Ret = lread(Fi, gptr, Buffer)
            Close Fi
        End If
        Else
        Close Fi
        Wdth = 600                  ' Arbitrary setting
        Hght = 600                  ' Arbitrary setting
        hMF = GetMetaFile(File$)
        End If
        Ret = SetMapMode(Printer.hDC, MM_ANISOTROPIC)
        Lft = (Printer.ScaleWidth - Wdth) / 2
        Tp = (Printer.ScaleHeight - Hght) / 2
        HL = SetViewportOrg(Printer.hDC, Lft, Tp)
        HL = SetViewportExt(Printer.hDC, Wdth, Hght)
        Ret = PlayMetaFile(Printer.hDC, hMF)
        If WMFH.key = &H9AC6CDD7 Then
        Ret = GlobalUnlock(hMF)
        Ret = GlobalFree(hMF)
        Else
        Ret = DeleteMetaFile(hMF)
        End If
        Ret = RestoreDC(Printer.hDC, SavDC)
    End If

    Case "wpg"
    BMPhndl = ReadWPG(File$, dhDC, dhWnd, Dither, Prn, 0, 0, Scle)

    Case Else
    Frame1.Visible = True
    Screen.MousePointer = 0
    Exit Sub

    End Select

    If BMPhndl >= 0 And Prn = False Then
    Mnu_Close.Visible = True
    Pic_Graphic.Width = Pic_Graphic.Width * Scle
    Pic_Graphic.Height = Pic_Graphic.Height * Scle
    Form_Resize
    If BMPhndl > 0 Then Pic_Graphic.Picture = ClipBoard.GetData(9)
    Ret = DoEvents()
    Pic_Graphic.AutoRedraw = True
    If BMPhndl > 0 Then
        TempDC = CreateCompatibleDC(Pic_Graphic.hDC)
        hDCprev = SelectObject(TempDC, BMPhndl)
        Ret = StretchBlt(Pic_Graphic.hDC, 0, 0, Pic_Graphic.Width, Pic_Graphic.Height, TempDC, 0, 0, Pic_Graphic.Width / Scle, Pic_Graphic.Height / Scle, SRCCOPY)
        Ret = SelectObject(TempDC, hDCprev)
        Ret = DeleteDC(TempDC)
        Ret = DeleteObject(BMPhndl)
        Pic_Graphic.Visible = True
    End If
    End If
    If BMPhndl < 0 Then
    Screen.MousePointer = 0
    Beep
    If BMPhndl < -13 Then BMPhndl = -13
    MsgBox "Error occurred - " & Errors$(BMPhndl), 48, "Graphics Viewer"
    Frame1.Visible = True
    End If
    If Index = 1 Then Printer.EndDoc
    Screen.MousePointer = 0
    Exit Sub

Er_hndl:
    Beep
    Screen.MousePointer = 0
    If TempDC Then Ret = DeleteDC(TempDC)
    If BMPhndl Then Ret = DeleteObject(BMPhndl)
    MsgBox Error$, 48, "Graphics Viewer"
    Exit Sub
End Sub

Sub Cmd_Exit_Click ()
    Unload Form1
End Sub

Sub Cmd_Info_Click ()
    If File1.ListIndex < 0 Then Beep: Exit Sub
    Screen.MousePointer = 11
    Hscroll1.Visible = False
    Vscroll1.Visible = False
    Picture2.Visible = False
    Found_BMP = False
    Lst_Info.Clear
    Lst_Info.Visible = True
    Pic_Graphic.Visible = False
    File$ = Dir1.Path & "\" & File1.List(File1.ListIndex)
    Frm_JPEG.Visible = False

    Select Case Right$(File$, 3)
    Case "art"
    Info_ART

    Case "bmp"
    Info_BMP

    Case "cut"
    Info_CUT

    Case "dib"
    Info_BMP

    Case "gem"
    Info_IMG

    Case "gif"
    Info_GIF

    Case "hrz"
    Info_HRZ

    Case "iff"
    Info_IFF

    Case "img"
    Info_IMG

    Case "jpg"
    Info_JPG
    Frm_JPEG.Visible = True

    Case "lbm"
    Info_IFF

    Case "mac"
    Info_MAC

    Case "msp"
    Info_MSP

    Case "pcx"
    Info_PCX

    Case "pic"
    Info_PIC

    Case "ras"
    Info_RAS

    Case "rle"
    Info_BMP

    Case "tga"
    Info_TGA

    Case "tif"
    Info_TIF

    Case "wmf"
    Info_WMF

    Case "wpg"
    Info_WPG

    End Select
    Close
    Screen.MousePointer = 0
End Sub

Function CnvtInt& (in$)
    Dim C&
    C = Asc(Left$(in$, 1))
    CnvtInt = C * 256 + Asc(Right$(in$, 1))
End Function

Function CnvtLng# (Lng$)
    Dim C#, I#
    For I = 3 To 0 Step -1
    C = C + Asc(Mid$(Lng$, 4 - I, 1)) * 256 ^ I
    Next I
    CnvtLng = C
End Function

Sub Dir1_Change ()
    File1.Path = Dir1.Path
End Sub

Sub Disp_GIF ()
    Dim GIF As GIFHEADER
    Dim Image As IMAGEBLOCK
    Dim TempDC%, hDCprev%
    Dim Oldfont%, Newfont%
    Dim CX%, CY%, X%, Y%
    Dim A$, I%
    Dim Flag%
    Dim NumClrs%, NumClrBits%
    Dim Offset&, ImgOffset&
    Dim Clr%
    Dim Pal$

    Fi = FreeFile
    Open File$ For Binary As Fi
    Get #Fi, , GIF
    Flag = Asc(GIF.Flags)
    If (Flag And &H80) Then
    NumClrBits = (Flag And &H7) + 1
    NumClrs = 2 ^ NumClrBits
    Pal$ = String$(NumClrs * 3, 0)
    Get #Fi, , Pal$
    End If
    Do
    Get #Fi, , BT$
    Select Case BT$
    Case ","
        ImgOffset = Seek(Fi) - 1
        If Found_BMP Then
        Beep
        Ret = MsgBox("There is another graphic in this file, Display it?", 36, "GIF Reader")
        If Ret = 7 Then Close : Exit Sub
        Pic_Graphic.AutoRedraw = False
        Pic_Graphic.Cls
        End If
        Get #Fi, , Image
        Flag = Asc(Image.Flags)
        If (Flag And &H80) Then
        NumClrBits = (Flag And &H7) + 1
        NumClrs = 2 ^ NumClrBits
        Pal$ = String$(NumClrs * 3, 0)
        Get #Fi, , Pal$
        End If
        Offset = Seek(Fi)
        Close
        BMPhndl = ReadGIF(File$, dhDC, dhWnd, Dither, Prn, 0, 0, Scle, ImgOffset)
        If Prn Then Exit Sub
        Fi = FreeFile
        Open File$ For Binary As Fi
        Seek #Fi, Offset
        Screen.MousePointer = 0
        If BMPhndl > 0 And Prn = 0 Then
        Found_BMP = True
        Mnu_Close.Visible = True
        Pic_Graphic.Width = Pic_Graphic.Width * Scle
        Pic_Graphic.Height = Pic_Graphic.Height * Scle
        Form_Resize
        If BMPhndl > 0 Then Pic_Graphic.Picture = ClipBoard.GetData(9)
        Ret = DoEvents()
        Pic_Graphic.AutoRedraw = True
        TempDC = CreateCompatibleDC(Pic_Graphic.hDC)
        hDCprev = SelectObject(TempDC, BMPhndl)
        Ret = StretchBlt(Pic_Graphic.hDC, 0, 0, Pic_Graphic.Width, Pic_Graphic.Height, TempDC, 0, 0, Pic_Graphic.Width / Scle, Pic_Graphic.Height / Scle, SRCCOPY)
        Ret = SelectObject(TempDC, hDCprev)
        Ret = DeleteDC(TempDC)
        Ret = DeleteObject(BMPhndl)
        Pic_Graphic.Visible = True
        End If
        I = GetC()
        I = 1
        Do Until I = 0
        I = GetC()
        Seek #Fi, Seek(Fi) + I
        Loop

    Case "!"
        Get #Fi, , BT$

        Select Case Asc(BT$)          ' Plain Text Extension
        Case 1
        Dim PlnTxt As PLAINTEXT
        Dim lf As LOGFONT
        Dim tm As TEXTMETRIC
        Ret = GetTextMetrics(Pic_Graphic.hDC, tm)
        lf.lfweight = tm.tmweight
        Get #Fi, , PlnTxt
        Clr = Asc(PlnTxt.ForeColor)
        Pic_Graphic.ForeColor = RGB(Asc(Mid$(Pal$, Clr * 3 + 1, 1)), Asc(Mid$(Pal$, Clr * 3 + 2, 1)), Asc(Mid$(Pal$, Clr * 3 + 3, 1)))
        Clr = Asc(PlnTxt.BackColor)
        Pic_Graphic.BackColor = RGB(Asc(Mid$(Pal$, Clr * 3 + 1, 1)), Asc(Mid$(Pal$, Clr * 3 + 2, 1)), Asc(Mid$(Pal$, Clr * 3 + 3, 1)))
        X = PlnTxt.GridWidth
        Y = PlnTxt.GridHeight
        Pic_Graphic.CurrentY = PlnTxt.Top
        lf.lfheight = Asc(PlnTxt.CellWidth)
        lf.lfwidth = Asc(PlnTxt.CellHeight)
        Newfont% = CreateFontIndirect%(lf)
        Oldfont% = SelectObject%(Pic_Graphic.hDC, Newfont%)
        CX = 0: CY = 0
        Do
        For I = 1 To GetC()
        Get #Fi, , BT$
        If BT$ = Chr$(0) Or EOF(Fi) Then Exit Do
        If BT$ = Chr$(13) Then
            CY = CY + Y: CX = 0
        Else
            Ret = TextOut%(Pic_Graphic.hDC, PlnTxt.Left + CX, PlnTxt.Top + CY, BT$, 1)
        End If
        CX = CX + X
        Next I
        Loop
        Newfont% = SelectObject%(Pic_Graphic.hDC, Oldfont%)
        Ret = DeleteObject%(Newfont%)

        Case 249                          'Control Block Extension
        Dim Cntrlblk As CONTROLBLOCK
        Get #Fi, , Cntrlblk
        Flag = Asc(Cntrlblk.Flags)
        Select Case (Flag * 4) And &H7
        Case 0
            A$ = "No disposal specified"

        Case 1
            A$ = "Do not dispose"

        Case 2
            A$ = "Dispose to background color"

        Case 3
            A$ = "Dispose to previous graphic"

        Case Else
            A$ = "Unknown disposal procedure"

        End Select

        Beep
        MsgBox A$, 0, "Control Block"

        If Flag And &H2 Then
            MsgBox "User input required, delay for " & Format$(Cntrlblk.Delay) & " seconds", 0, "Control Block"
        End If

        If Flag And &H1 Then
            MsgBox "Transparent color: " & Format$(Asc(Cntrlblk.Transparent_Color)), 0, "Control Block"
        Else
            MsgBox "No transparent color", 0, "GIF Reader"
        End If

        Case 254                   'Comment Extension
        A$ = ""
        Do
        For I = 1 To GetC()
        Get #Fi, , BT$
        If BT$ = Chr$(0) Or EOF(Fi) Then Exit Do
        A$ = A$ & BT$
        Next I
        Loop
        Beep
        MsgBox A$, 64, "GIF Reader"

        Case 255                             'Application Extension
        Dim Appl As Application
        Get #Fi, , Appl
        MsgBox "Application identification string: " & Appl.Applstring, 0, "Application Block"
        Do
        For I = 1 To GetC()
        Get #Fi, , BT$
        If BT$ = Chr$(0) Or EOF(Fi) Then Exit Do
        Next I
        Loop

        Case Else
        MsgBox "Skipping unknown control block" & Format$(Asc(BT$)), 0, "GIF Reader"
        Do
        For I = 1 To GetC()
        Get #Fi, , BT$
        If BT$ = Chr$(0) Or EOF(Fi) Then Exit Do
        Next I
        Loop

        End Select

    Case Chr$(0)
        If EOF(Fi) Then Exit Do

    Case Else
        Exit Do

    End Select
    Loop
    Close
End Sub

Sub File1_Click ()
    Cmd_Info_Click
End Sub

Sub File1_DblClick ()
    Cmd_Disp_Click 0
End Sub

Function First_Marker ()
    Dim C1, C2
    C1 = GetC()
    C2 = GetC()
    If C1 <> &HFF Or C2 <> M_SOI Then
    MsgBox "Not a JPEG file", 48, "Graphics Viewer"
    Close Fi
    First_Marker = -1
    Exit Function
    End If
    First_Marker = C2
End Function

Sub Form_Load ()
    Dim I

    Ret = SendMessage(Lst_Info.hWnd, LB_SETTABSTOPS, 1, 70)
    For I = 254 To 532
    Tags(I) = "Unknown"
    Next I
    Typs(0) = "Byte"
    Typs(1) = "ASCII"
    Typs(2) = "Unsigned Int"
    Typs(3) = "Unsigned Long"
    Typs(4) = "Rational"
    Tags(254) = "NewSubFileType"
    Tags(255) = "SubFileType"
    Tags(256) = "ImageWidth"
    Tags(257) = "ImageHeight"
    Tags(258) = "BitsPerSample"
    Tags(259) = "Compression"
    Tags(262) = "PhotometricInterpretation"
    Tags(263) = "Threshholding"
    Tags(264) = "CellWidth"
    Tags(265) = "CellLength"
    Tags(266) = "FillOrder"
    Tags(269) = "DocumentName"
    Tags(270) = "ImageDescription"
    Tags(271) = "Make"
    Tags(272) = "Model"
    Tags(273) = "StripOffsets"
    Tags(274) = "Orientation"
    Tags(277) = "SamplesPerPixel"
    Tags(278) = "RowsPerStrip"
    Tags(279) = "StripByteCounts"
    Tags(280) = "MinSampleValue"
    Tags(281) = "MaxSampleValue"
    Tags(282) = "XResolution"
    Tags(283) = "YResolution"
    Tags(284) = "PlanarConfiguration"
    Tags(285) = "PageName"
    Tags(286) = "XPosition"
    Tags(287) = "YPosition"
    Tags(288) = "FreeOffsets"
    Tags(289) = "FreeByteCounts"
    Tags(290) = "GrayResponseUnit"
    Tags(291) = "GrayResponseCurve"
    Tags(292) = "Group3Options"
    Tags(293) = "Group4Options"
    Tags(296) = "ResolutionUnit"
    Tags(297) = "PageNumber"
    Tags(300) = "ColorResponseUnit"
    Tags(301) = "ColorResponseCurves"
    Tags(305) = "Software"
    Tags(306) = "DateTime"
    Tags(315) = "Artist"
    Tags(316) = "HostComputer"
    Tags(317) = "Predictor"
    Tags(318) = "WhitePoint"
    Tags(319) = "PrimaryChromaticities"
    Tags(320) = "ColorMap"
    Tags(321) = "HalfToneHints"
    Tags(322) = "TileWidth"
    Tags(323) = "TileLength"
    Tags(324) = "TileOffsets"
    Tags(325) = "TileByteCounts"
    Tags(326) = "BadFaxLines"
    Tags(327) = "CleanFaxData"
    Tags(328) = "ConsecutiveBadFaxLines"
    Tags(332) = "InkSet"
    Tags(333) = "InkNames"
    Tags(334) = "NumberofInks"
    Tags(336) = "DotRange"
    Tags(337) = "TargetPrinter"
    Tags(338) = "ExtraSamples"
    Tags(339) = "SampleFormat"
    Tags(340) = "SMinSampleValue"
    Tags(341) = "SMaxSampleValue"
    Tags(342) = "TransferRange"
    Tags(512) = "JPEGProc"
    Tags(513) = "JPEGInterchangeFormat"
    Tags(514) = "JPEGInterchangeFormatLength"
    Tags(515) = "JPEGRestartInterval"
    Tags(517) = "JPEGLosslessPredictors"
    Tags(518) = "JPEGPointTransforms"
    Tags(519) = "JPEGQTables"
    Tags(520) = "JPEGDCTTables"
    Tags(521) = "JPEGACCTTables"
    Tags(529) = "YCbCrCoefficients"
    Tags(530) = "YCbCrSubSampling"
    Tags(531) = "YCbCrPositioning"
    Tags(532) = "ReferenceBlackWhite"
    Errors$(-1) = "Could not open file"
    Errors$(-2) = "Error allocating memory"
    Errors$(-3) = "Error reading file"
    Errors$(-4) = "Error creating DIB"
    Errors$(-5) = "Could not create bitmap"
    Errors$(-6) = "Could not allocate memory for DIB"
    Errors$(-7) = "Bad code in GIF file"
    Errors$(-8) = "Bad first code in GIF file"
    Errors$(-9) = "Bad bit count in GIF file"
    Errors$(-10) = "Bad header in file"
    Errors$(-11) = "No bitmap found in file"
    Errors$(-12) = "Could not create or realize palette"
    Errors$(-13) = "Unknown Error"
    Ret = GetDeviceCaps(Pic_Graphic.hDC, PLANES) * GetDeviceCaps(Pic_Graphic.hDC, BITSPIXEL)
    If Ret <= 8 Then Opt_Dither(2).Value = True
    Move 0, 0
    Width = Screen.Width
    Height = Screen.Height
End Sub

Sub Form_Resize ()
    If Pic_Graphic.Height > Form1.ScaleHeight Then
    Vscroll1.Visible = True
    Else
    Vscroll1.Visible = False
    End If
    If Pic_Graphic.Width > Form1.ScaleWidth Then
    Hscroll1.Visible = True
    Else
    Hscroll1.Visible = False
    End If
    Vscroll1.Max = Pic_Graphic.Height - Form1.ScaleHeight + Hscroll1.Height
    Hscroll1.Max = Pic_Graphic.Width - Form1.ScaleWidth + Vscroll1.Width
    If Vscroll1.Visible Or Hscroll1.Visible Then
    Picture2.Visible = True
    Else
    Picture2.Visible = False
    End If
    Hscroll1.Width = Form1.ScaleWidth - Vscroll1.Width
    Vscroll1.Height = Form1.ScaleHeight - Hscroll1.Height
    Hscroll1.Move 0, Form1.ScaleHeight - Hscroll1.Height
    Vscroll1.Move Form1.ScaleWidth - Vscroll1.Width, 0
    Picture2.Move Form1.ScaleWidth - Vscroll1.Width, Form1.ScaleHeight - Hscroll1.Height
    Vscroll1.Max = Pic_Graphic.Height - Form1.ScaleHeight + Hscroll1.Height
    Hscroll1.Max = Pic_Graphic.Width - Form1.ScaleWidth + Vscroll1.Width
End Sub

Function GetC% ()
    Get #Fi, , BT$
    GetC = Asc(BT$)
End Function

Function GetInt& ()
    Dim C&, N&
    C = GetC()
    If IntMot Then N = C Else N = C * 256
    C = GetC()
    If IntMot Then N = N + C * 256 Else N = N + C
    GetInt = N
End Function

Function GetLng& ()
    Dim C&, N&
    C = GetC()
    If IntMot Then N = C Else N = C * 16777216
    C = GetC()
    If IntMot Then N = N + C * 256 Else N = N + C * 65536
    C = GetC()
    If IntMot Then N = N + C * 65536 Else N = N + C * 256
    C = GetC()
    If IntMot Then N = N + C * 16777216 Else N = N + C
    GetLng = N
End Function

Sub HScroll1_Change ()
    PX = -Hscroll1.Value
    Pic_Graphic.Move PX, PY
End Sub

Sub Info_ART ()
    Dim C&

    IntMot = True
    Fi = FreeFile
    Open File$ For Binary As Fi
    C = GetInt()
    C = GetInt()
    Lst_Info.AddItem "Image Width" & Chr$(9) & ": " & Format$(C)
    C = GetInt()
    C = GetInt()
    Lst_Info.AddItem "Image Height" & Chr$(9) & ": " & Format$(C)
    Lst_Info.AddItem "Bits per Pixel" & Chr$(9) & ": 1 "
    Close
End Sub

Sub Info_BMP ()
    Dim BH    As BMPHEAD
    Dim BMP   As BITMAPINFOHEADER

    Fi = FreeFile
    Open File$ For Binary As Fi
    Get #Fi, , BH
    Get #Fi, , BMP
    Close
    Lst_Info.AddItem "ID" & Chr$(9) & ": " & Format$(BH.ID)
    Lst_Info.AddItem "File Size" & Chr$(9) & ": " & Format$(BH.FileSize)
    Lst_Info.AddItem "Reserved(0)" & Chr$(9) & ": " & Format$(BH.Reserved(0))
    Lst_Info.AddItem "Reserved(1)" & Chr$(9) & ": " & Format$(BH.Reserved(1))
    Lst_Info.AddItem "Header Size" & Chr$(9) & ": " & Format$(BH.HeaderSize)
    Lst_Info.AddItem "Info Size" & Chr$(9) & ": " & Format$(BMP.biSize)
    Lst_Info.AddItem "Width" & Chr$(9) & ": " & Format$(BMP.biWidth)
    Lst_Info.AddItem "Depth" & Chr$(9) & ": " & Format$(BMP.biHeight)
    Lst_Info.AddItem "BiPlanes" & Chr$(9) & ": " & Format$(BMP.biPlanes)
    Lst_Info.AddItem "Bits" & Chr$(9) & ": " & Format$(BMP.biBitCount)
    If BMP.biSize <> 12 Then
    Lst_Info.AddItem "BiCompression" & Chr$(9) & ": " & Format$(BMP.biCompression)
    Lst_Info.AddItem "BiSizeImage" & Chr$(9) & ": " & Format$(BMP.biSizeImage)
    Lst_Info.AddItem "BiPiXPelsPerMeter" & Chr$(9) & ": " & Format$(BMP.biXPelsPerMeter)
    Lst_Info.AddItem "BiPiYPelsPerMeter" & Chr$(9) & ": " & Format$(BMP.biYPelsPerMeter)
    Lst_Info.AddItem "BiClrUsed" & Chr$(9) & ": " & Format$(BMP.biClrUsed)
    Lst_Info.AddItem "BiClrImportant" & Chr$(9) & ": " & Format$(BMP.biClrImportant)
    Else
    Lst_Info.AddItem "Bitmap from OS/2"
    End If
End Sub

Sub Info_CUT ()
    Dim CUT As CUTHEAD
    Dim Pal$

    Fi = FreeFile
    Open File$ For Binary As Fi
    Get #Fi, , CUT
    Close
    Lst_Info.AddItem "Width" & Chr$(9) & ": " & Format$(CUT.Width)
    Lst_Info.AddItem "Height" & Chr$(9) & ": " & Format$(CUT.Height)
    Pal$ = Left$(File$, Len(File$) - 3) & "pal"
    If Dir$(Pal$) = "" Then Pal$ = "No Palette"
    Lst_Info.AddItem "Palette file" & Chr$(9) & ": " & Pal$
End Sub

Sub Info_GIF ()
    Dim GIF As GIFHEADER
    Dim Image As IMAGEBLOCK
    Dim A$, B$, I%, Clr%
    Dim Flag%, NumClrs%, NumClrBits%

    Fi = FreeFile
    Open File$ For Binary As Fi
    Get #Fi, , GIF
    Lst_Info.AddItem "Signature" & Chr$(9) & ": " & GIF.GIF
    Lst_Info.AddItem "Screen Width" & Chr$(9) & ": " & Format$(GIF.Width)
    Lst_Info.AddItem "Screen Height" & Chr$(9) & ": " & Format$(GIF.Height)
    Lst_Info.AddItem "Bits" & Chr$(9) & ": " & Format$((Asc(GIF.Flags) And &H7) + 1)
    Lst_Info.AddItem "Colors" & Chr$(9) & ": " & Format$(2 ^ ((Asc(GIF.Flags) And &H7) + 1))
    Lst_Info.AddItem "Background" & Chr$(9) & ": " & Format$(Asc(GIF.Background))
    Lst_Info.AddItem "Aspect" & Chr$(9) & ": " & Format$(Asc(GIF.Aspect))
    Flag = Asc(GIF.Flags)
    B$ = "No"
    If (Flag And &H80) Then
    NumClrBits = (Flag And &H7) + 1
    NumClrs = 2 ^ NumClrBits
    A$ = String$(NumClrs * 3, 0)
    Get #Fi, , A$
    B$ = "Yes"
    End If
    Lst_Info.AddItem "Global color map" & Chr$(9) & ": " & B$
    Do
    Get #Fi, , BT$
    Select Case BT$
    Case ","
        Lst_Info.AddItem "Image block"
        Get #Fi, , Image
        Lst_Info.AddItem "Image Width" & Chr$(9) & ": " & Format$(Image.Width)
        Lst_Info.AddItem "Image Height" & Chr$(9) & ": " & Format$(Image.Height)
        Flag = Asc(Image.Flags)
        B$ = "No"
        If (Flag And &H80) Then
        Lst_Info.AddItem "Image bits" & Chr$(9) & ": " & Format$((Flag And &H7) + 1)
        NumClrBits = (Flag And &H7) + 1
        NumClrs = 2 ^ NumClrBits
        A$ = String$(NumClrs * 3, 0)
        Get #Fi, , A$
        B$ = "Yes"
        End If
        Lst_Info.AddItem "Local color map" & Chr$(9) & ": " & B$
        B$ = "No"
        If (Flag And &H40) Then B$ = "Yes"
        Lst_Info.AddItem "Interlaced" & Chr$(9) & ": " & B$
        I = GetC()
        I = 1
        Do Until I = 0
        I = GetC()
        Seek #Fi, Seek(Fi) + I
        Loop

    Case "!"
        Get #Fi, , BT$

        Select Case Asc(BT$)          ' Plain Text Extension
        Case 1
        Dim PlnTxt As PLAINTEXT
        Lst_Info.AddItem "Plain text block"
        Get #Fi, , PlnTxt
        Clr = Asc(PlnTxt.ForeColor)
        Lst_Info.AddItem "Fore color" & Chr$(9) & ": " & Format$(Clr)
        Clr = Asc(PlnTxt.BackColor)
        Lst_Info.AddItem "Back color" & Chr$(9) & ": " & Format$(Clr)
        Lst_Info.AddItem "Text location (top)" & Chr$(9) & ": " & Format$(PlnTxt.Top)
        Lst_Info.AddItem "Text location (left)" & Chr$(9) & ": " & Format$(PlnTxt.Left)
        Lst_Info.AddItem "Grid width" & Chr$(9) & ": " & Format$(PlnTxt.GridWidth)
        Lst_Info.AddItem "Grid height" & Chr$(9) & ": " & Format$(PlnTxt.GridHeight)
        Lst_Info.AddItem "Cell width" & Chr$(9) & ": " & Format$(PlnTxt.CellWidth)
        Lst_Info.AddItem "Cell height" & Chr$(9) & ": " & Format$(PlnTxt.CellHeight)
        A$ = ""
        Do
        For I = 1 To GetC()
        Get #Fi, , BT$
        If BT$ = Chr$(0) Or EOF(Fi) Then Exit Do
        A$ = A$ + B$
        Next I
        Loop
        Lst_Info.AddItem "Text" & Chr$(9) & ": " & B$

        Case 249                      'Control Block Extension
        Dim Cntrlblk As CONTROLBLOCK
        Get #Fi, , Cntrlblk
        Flag = Asc(Cntrlblk.Flags)
        Select Case (Flag * 4) And &H7
        Case 0
            A$ = "No disposal specified"

        Case 1
            A$ = "Do not dispose"

        Case 2
            A$ = "Dispose to background color"

        Case 3
            A$ = "Dispose to previous graphic"

        Case Else
            A$ = "Unknown disposal procedure"

        End Select

        Lst_Info.AddItem "Control block" & Chr$(9) & ": " & A$

        If Flag And 2 Then
            Lst_Info.AddItem "User input required, delay for" & Chr$(9) & ": " & Format$(Cntrlblk.Delay) & " seconds"
        End If

        If Flag And 1 Then
            Lst_Info.AddItem "Transparent color" & Chr$(9) & ": " & Format$(Asc(Cntrlblk.Transparent_Color))
        Else
            Lst_Info.AddItem "No transparent color"
        End If

        Case 254                      'Comment Extension
        A$ = ""
        Do
        For I = 1 To GetC()
        Get #Fi, , BT$
        If BT$ = Chr$(0) Or EOF(Fi) Then Exit Do
        A$ = A$ & BT$
        Next I
        Loop
        Lst_Info.AddItem "Comment extension" & Chr$(9) & ": " & Format$(Len(A$)) & " characters"

        Case 255                      'Application Extension
        Dim Appl As Application
        Get #Fi, , Appl
        Lst_Info.AddItem "Application identification string" & Chr$(9) & ": " & Appl.Applstring
        Lst_Info.AddItem "Application authorization string" & Chr$(9) & ": " & Appl.Authentication
        Do
        For I = 1 To GetC()
        Get #Fi, , BT$
        If BT$ = Chr$(0) Or EOF(Fi) Then Exit Do
        Next I
        Loop

        Case Else
        Lst_Info.AddItem "Unknown control block"
        Do
        For I = 1 To GetC()
        Get #Fi, , BT$
        If BT$ = Chr$(0) Or EOF(Fi) Then Exit Do
        Next I
        Loop

        End Select

    Case Chr$(0)
        If EOF(Fi) Then Exit Do

    Case Else
        Exit Do

    End Select
    Loop
    Close
End Sub

Sub Info_HRZ ()
    If FileLen(File$) <> 184320 Then
    MsgBox "Not a HRZ file", 48, "Graphics Viewer"
    End If
    Lst_Info.AddItem "Image Width" & Chr$(9) & ": 256"
    Lst_Info.AddItem "Image Height" & Chr$(9) & ": 240"
    Lst_Info.AddItem "Bits per Pixel" & Chr$(9) & ": 24"
End Sub

Sub Info_IFF ()
    Dim IFF As IFFHEAD, BMHEAD As BMHD
    Dim B$, Lng As String * 4
    Dim Chnk As String * 4, Pos&, Size&

    Fi = FreeFile
    Open File$ For Binary As Fi
    Get #Fi, , IFF
    Lst_Info.AddItem "Type" & Chr$(9) & ": " & IFF.Ftype
    Lst_Info.AddItem "Size" & Chr$(9) & ": " & Format$(CnvtLng(IFF.Size))
    Lst_Info.AddItem "SubType" & Chr$(9) & ": " & IFF.SubType
    Do
    Get #Fi, , Chnk$
    Get #Fi, , Lng$
    Pos = Seek(Fi)
    Size = CnvtLng(Lng$)
    If Size And 1 Then Size = Size + 1
    Select Case Chnk$
    Case "BMHD"
    Get #Fi, , BMHEAD
    Lst_Info.AddItem "Width" & Chr$(9) & ": " & Format$(CnvtInt(BMHEAD.W))
    Lst_Info.AddItem "Height" & Chr$(9) & ": " & Format$(CnvtInt(BMHEAD.H))
    Lst_Info.AddItem "Top" & Chr$(9) & ": " & Format$(CnvtInt(BMHEAD.Y))
    Lst_Info.AddItem "Left" & Chr$(9) & ": " & Format$(CnvtInt(BMHEAD.X))
    Lst_Info.AddItem "Color planes" & Chr$(9) & ": " & Format$(Asc(BMHEAD.nplanes))
    B$ = "Unknown"
    If BMHEAD.Masking = Chr$(0) Then B$ = "No mask present"
    If BMHEAD.Masking = Chr$(1) Then B$ = "Mask present"
    If BMHEAD.Masking = Chr$(2) Then B$ = "Mask w/transparent color"
    If BMHEAD.Masking = Chr$(3) Then B$ = "Lasso mask"
    Lst_Info.AddItem "Masking" & Chr$(9) & ": " & B$
    B$ = "Uncompressed"
    If BMHEAD.Compression = Chr$(1) Then B$ = "Compressed"
    Lst_Info.AddItem "Compression" & Chr$(9) & ": " & B$
    Lst_Info.AddItem "X Aspect" & Chr$(9) & ": " & Format$(Asc(BMHEAD.XAspect))
    Lst_Info.AddItem "Page Width" & Chr$(9) & ": " & Format$(CnvtInt(BMHEAD.PageW))
    Lst_Info.AddItem "Page Height" & Chr$(9) & ": " & Format$(CnvtInt(BMHEAD.PageH))

    Case "CMAP"
    Lst_Info.AddItem "Color map size" & Chr$(9) & ": " & Format$(Size)

    Case "TEXT"
    If Size <= 40 Then
        B$ = Space$(Size)
        Get #Fi, , B$
        Lst_Info.AddItem "Text" & Chr$(9) & ": " & B$
    Else
        Lst_Info.AddItem "Chunk Name" & Chr$(9) & ": " & Chnk$
        Lst_Info.AddItem "Chunk Size" & Chr$(9) & ": " & Format$(Size)
    End If

    Case Else
    Lst_Info.AddItem "Chunk Name" & Chr$(9) & ": " & Chnk$
    Lst_Info.AddItem "Chunk Size" & Chr$(9) & ": " & Format$(Size)

    End Select
    Seek #Fi, Pos + Size
    Loop Until Chnk$ = "BODY" Or EOF(Fi)
    Close
End Sub

Sub Info_IMG ()
    Dim A$, I&, H&, N&

    IntMot = False
    Fi = FreeFile
    Open File$ For Binary As Fi
    I = GetInt()
    Lst_Info.AddItem "Version" & Chr$(9) & ": " & Hex$(I)
    H = GetInt()
    Lst_Info.AddItem "Header Length" & Chr$(9) & ": " & Format$(H)
    N = GetInt()
    Lst_Info.AddItem "Number of Planes" & Chr$(9) & ": " & Format$(N)
    I = GetInt()
    Lst_Info.AddItem "Pattern Length" & Chr$(9) & ": " & Format$(I)
    I = GetInt()
    Lst_Info.AddItem "Pixel Width" & Chr$(9) & ": " & Format$(I)
    I = GetInt()
    Lst_Info.AddItem "Pixel Height" & Chr$(9) & ": " & Format$(I)
    I = GetInt()
    Lst_Info.AddItem "Image Width" & Chr$(9) & ": " & Format$(I)
    I = GetInt()
    Lst_Info.AddItem "Image Height" & Chr$(9) & ": " & Format$(I)
    A$ = "True Color"
    If H = 9 And N >= 2 Then
    I = GetInt()
    If I = 0 Then A$ = "Color Image Data"
    If I = 1 Then A$ = "Gray-scale Image Data"
    End If
    If H = 8 Then A$ = "16 color Gray-Scale"
    Lst_Info.AddItem "Image" & Chr$(9) & ": " & A$
    Close
End Sub

Sub Info_JPG ()
    Dim Marker, T

    IntMot = False
    Fi = FreeFile
    Open File$ For Binary As Fi

    If First_Marker() <> M_SOI Then
    MsgBox "Expected SOI marker first", 48, "Graphics Viewer"
    Close Fi
    Exit Sub
    End If
    Do
    Marker = Next_Marker()
    Select Case Marker
    Case -1
        MsgBox "Error ocurred", 48, "JPEG Reader"
        Exit Sub

    Case M_SOF0, M_SOF1, M_SOF2, M_SOF3, M_SOF5, M_SOF6, M_SOF7, M_SOF9, M_SOF10, M_SOF11, M_SOF13, M_SOF14, M_SOF15
        Process_SOFn Marker

    Case M_SOS
        Lst_Info.AddItem "Start of scan"
        Exit Sub

    Case M_SOI
        Lst_Info.AddItem "Start of image"
        Exit Sub

    Case M_EOI
        Lst_Info.AddItem "End of image"
        Exit Sub

    Case M_COM
        Process_COM
        If Canc Then Exit Sub

    Case Else
        Skip_Variable

    End Select

    Loop
    Close
End Sub

Sub Info_MAC ()
    Dim MAC As MACHEAD
    Dim Dt#

    Fi = FreeFile
    Open File$ For Binary As Fi
    Get #Fi, , MAC
    Close
    Lst_Info.AddItem "Name" & Chr$(9) & ": " & MAC.Name
    Lst_Info.AddItem "Type" & Chr$(9) & ": " & MAC.Type
    Lst_Info.AddItem "Creator" & Chr$(9) & ": " & MAC.Creator
    Lst_Info.AddItem "Data fork size" & Chr$(9) & ": " & Format$(CnvtLng(MAC.DataFork_Size))
    Lst_Info.AddItem "Resource fork size" & Chr$(9) & ": " & Format$(CnvtLng(MAC.RsrcFork_Size))
    Dt = CnvtLng(MAC.Creation_Date) / 86400 + 1462
    Lst_Info.AddItem "Creation date" & Chr$(9) & ": " & CVDate(Dt)
    Dt = CnvtLng(MAC.Modif_Date) / 86400 + 1462
    Lst_Info.AddItem "Modification date" & Chr$(9) & ": " & CVDate(Dt)
    Lst_Info.AddItem "Width" & Chr$(9) & ": 576"
    Lst_Info.AddItem "Height" & Chr$(9) & ": 720"
End Sub

Sub Info_MSP ()
    Dim MSP As MSPHEAD
    Dim A$

    Fi = FreeFile
    Open File$ For Binary As Fi
    Get #Fi, , MSP
    Close
    A$ = "Unknown"
    If MSP.Key1 = 24900 And MSP.Key2 = 19822 Then A$ = "1.0"
    If MSP.Key1 = 26956 And MSP.Key2 = 21358 Then A$ = "2.0"
    Lst_Info.AddItem "Windows Version" & Chr$(9) & ": " & A$
    Lst_Info.AddItem "Width" & Chr$(9) & ": " & Format$(MSP.Width)
    Lst_Info.AddItem "Height" & Chr$(9) & ": " & Format$(MSP.Height)
    Lst_Info.AddItem "Screen Aspect X" & Chr$(9) & ": " & Format$(MSP.ScrAspX)
    Lst_Info.AddItem "Screen Aspect Y" & Chr$(9) & ": " & Format$(MSP.ScrAspY)
    Lst_Info.AddItem "Printer Aspect X" & Chr$(9) & ": " & Format$(MSP.PrnAspX)
    Lst_Info.AddItem "Printer Aspect Y" & Chr$(9) & ": " & Format$(MSP.PrnAspY)
End Sub

Sub Info_PCX ()
    Dim PCX As PCXHEAD
    Dim A$

    Fi = FreeFile
    Open File$ For Binary As Fi
    Get #Fi, , PCX
    Close
    A$ = "Unknown"
    If PCX.Version = Chr$(0) Then A$ = "2.5"
    If PCX.Version = Chr$(2) Then A$ = "2.8 Palette included"
    If PCX.Version = Chr$(3) Then A$ = "2.8 Use default palette"
    If PCX.Version = Chr$(5) Then A$ = "3.0 (or later)"
    Lst_Info.AddItem "Manufacturer" & Chr$(9) & ": " & Format$(Asc(PCX.Manufacturer))
    Lst_Info.AddItem "PC Paintbrush Ver." & Chr$(9) & ": " & A$
    Lst_Info.AddItem "Encoding" & Chr$(9) & ": " & Format$(Asc(PCX.Encoding))
    Lst_Info.AddItem "Bits per pixel" & Chr$(9) & ": " & Format$(Asc(PCX.Bits_Per_Pixel))
    Lst_Info.AddItem "Width" & Chr$(9) & ": " & Format$(PCX.XMax - PCX.XMin + 1)
    Lst_Info.AddItem "Height" & Chr$(9) & ": " & Format$(PCX.YMax - PCX.YMin + 1)
    Lst_Info.AddItem "Horiz. Resolution" & Chr$(9) & ": " & Format$(PCX.HRes)
    Lst_Info.AddItem "Vert. Resolution" & Chr$(9) & ": " & Format$(PCX.VRes)
    Lst_Info.AddItem "Color planes" & Chr$(9) & ": " & Format$(Asc(PCX.Color_Planes))
    Lst_Info.AddItem "Bytes per line" & Chr$(9) & ": " & Format$(PCX.Bytes_Per_Line)
    If PCX.Palette_Type = 1 Then A$ = "Gray scale" Else A$ = "Color"
    Lst_Info.AddItem "Palette type" & Chr$(9) & ": " & A$
End Sub

Sub Info_PIC ()
    Dim PIC As PICHEAD
    Dim A$, Bits%, PLANES%

    Fi = FreeFile
    Open File$ For Binary As Fi
    Get #Fi, , PIC
    Close
    Lst_Info.AddItem "Mark" & Chr$(9) & ": " & Hex$(PIC.Mark)
    Lst_Info.AddItem "Width" & Chr$(9) & ": " & Format$(PIC.XSize)
    Lst_Info.AddItem "Height" & Chr$(9) & ": " & Format$(PIC.YSize)
    Lst_Info.AddItem "Top" & Chr$(9) & ": " & Format$(PIC.YOff)
    Lst_Info.AddItem "Left" & Chr$(9) & ": " & Format$(PIC.XOff)
    Bits = Asc(PIC.BitsInf)
    PLANES = Fix((Bits And &HF0) / 16) + 1
    Bits = (PLANES) * (Bits And &HF)
    Lst_Info.AddItem "Bits per pixel" & Chr$(9) & ": " & Format$(Bits)
    Lst_Info.AddItem "Color planes" & Chr$(9) & ": " & Format$(PLANES)
    Lst_Info.AddItem "EMark" & Chr$(9) & ": " & Format$(Asc(PIC.EMark))
    A$ = "Unknown"
    Select Case PIC.EVideo
    Case "A"
    A$ = "CGA 4 color"

    Case "B"
    A$ = "PCjr/Tandy 1000"

    Case "C"
    A$ = "CGA 2 color"

    Case "D"
    A$ = "EGA low resolution"

    Case "E"
    A$ = "EGA 2 color"

    Case "F"
    A$ = "EGA 4 color"

    Case "G"
    A$ = "EGA 16 color"

    Case "H"
    A$ = "Hercules monochrome"

    Case "I"
    A$ = "Plantronic"

    Case "J"
    A$ = "EGA low resolution"

    Case "K"
    A$ = "AT&T or Toshiba 3100"

    Case "L"
    A$ = "VGA 256 color"

    Case "M"
    A$ = "VGA 16 color"

    Case "N"
    A$ = "Hercules InColor"

    Case "O"
    A$ = "VGA monochrome"

    End Select
    Lst_Info.AddItem "Video" & Chr$(9) & ": " & A$
    A$ = "Unknown"
    Select Case PIC.EDesc
    Case 0
    A$ = "No palette"

    Case 1
    A$ = "One byte of color for a CGA border"

    Case 2
    A$ = "PCjr palette"

    Case 3
    A$ = "EGA palette"

    Case 4
    A$ = "VGA palette"
    End Select
    Lst_Info.AddItem "Palette" & Chr$(9) & ": " & A$
    Lst_Info.AddItem "Palette size" & Chr$(9) & ": " & Format$(PIC.ESize)
End Sub

Sub Info_RAS ()
    Dim A$, I&

    IntMot = False
    Fi = FreeFile
    Open File$ For Binary As Fi
    I = GetLng()
    Lst_Info.AddItem "Magic Number" & Chr$(9) & ": " & Hex$(I)
    I = GetLng()
    Lst_Info.AddItem "Image Width" & Chr$(9) & ": " & Format$(I)
    I = GetLng()
    Lst_Info.AddItem "Image Height" & Chr$(9) & ": " & Format$(I)
    I = GetLng()
    Lst_Info.AddItem "Bits per Pixel" & Chr$(9) & ": " & Format$(I)
    I = GetLng()
    Lst_Info.AddItem "Image Size" & Chr$(9) & ": " & Format$(I)
    I = GetLng()

    Select Case I
    Case 0
    A$ = "Old    "
    Case 1
    A$ = "Standard"
    Case 2
    A$ = "Byte-encoded"
    Case 3
    A$ = "RGB format"
    Case 4
    A$ = "TIFF format"
    Case 5
    A$ = "IFF format"
    Case &HFFFF
    A$ = "Experimental"
    End Select

    Lst_Info.AddItem "Type" & Chr$(9) & ": " & A$
    I = GetLng()

    Select Case I
    Case 0
    A$ = "No color map"
    Case 1
    A$ = "RGB color map"
    Case 2
    A$ = "Raw color map"
    End Select

    Lst_Info.AddItem "Color Map Type" & Chr$(9) & ": " & A$
    I = GetLng()
    Lst_Info.AddItem "Color Map Length" & Chr$(9) & ": " & Format$(I)
    Close
End Sub

Sub Info_TGA ()
    Dim TGA As TGAHEAD
    Dim A$

    Fi = FreeFile
    Open File$ For Binary As Fi
    Get #Fi, , TGA
    Close
    Lst_Info.AddItem "IdentSize" & Chr$(9) & ": " & Format$(Asc(TGA.IdentSize))
    A$ = "None"
    If TGA.ColorMapType <> Chr$(0) Then A$ = "Present"
    Lst_Info.AddItem "Color Map" & Chr$(9) & ": " & A$
    A$ = "Unknown"
    Select Case Asc(TGA.ImageType)
    Case 1
    A$ = "Uncompressed palette-driven"

    Case 2
    A$ = "Uncompressed RGB"

    Case 3
    A$ = "Uncompressed monochrome"

    Case 9
    A$ = "Run-length encoded palette-driven"

    Case 10
    A$ = "Run-length encoded RGB"

    Case 11
    A$ = "Run-length encoded monochrome"

    End Select

    Lst_Info.AddItem "Image Type" & Chr$(9) & ": " & A$
    Lst_Info.AddItem "ColorMapStart" & Chr$(9) & ": " & Format$(TGA.ColorMapStart)
    Lst_Info.AddItem "ColorMapLength" & Chr$(9) & ": " & Format$(TGA.ColorMapLength)
    Lst_Info.AddItem "ColorMapBits" & Chr$(9) & ": " & Format$(Asc(TGA.ColorMapBits))
    Lst_Info.AddItem "X Start" & Chr$(9) & ": " & Format$(TGA.XStart)
    Lst_Info.AddItem "Y Start" & Chr$(9) & ": " & Format$(TGA.YStart)
    Lst_Info.AddItem "Width" & Chr$(9) & ": " & Format$(TGA.Width)
    Lst_Info.AddItem "Height" & Chr$(9) & ": " & Format$(TGA.Height)
    Lst_Info.AddItem "Color Bits" & Chr$(9) & ": " & Format$(Asc(TGA.Bits))
    A$ = "Normal storage"
    If Asc(TGA.Descriptor) And &H20 Then A$ = "Last line first"
    Lst_Info.AddItem "Storage" & Chr$(9) & ": " & A$
    A$ = "Normal storage"
    If Asc(TGA.Descriptor) And &H10 Then A$ = "Reversed"
    Lst_Info.AddItem "Storage" & Chr$(9) & ": " & A$
End Sub

Sub Info_TIF ()
    Dim A$, I%
    Dim Offset&, Tag&, Typ&, Length&, NumTags%

    Fi = FreeFile
    Open File$ For Binary As Fi
    A$ = Space$(2)
    Get #Fi, , A$
    If A$ = "II" Then IntMot = True Else IntMot = False
    If IntMot Then A$ = "Intel" Else A$ = "Motorola"
    Lst_Info.AddItem "Number Type" & Chr$(9) & ": " & A$
    A$ = Space$(2)
    Get #Fi, , A$
    If IntMot Then A$ = Left$(A$, 1) Else A$ = Right$(A$, 1)
    Offset = GetLng()
    Lst_Info.AddItem "Version" & Chr$(9) & ": " & Format$(Asc(A$))
    Lst_Info.AddItem "Offset" & Chr$(9) & ": " & Format$(Offset)
    Seek #Fi, Offset + 1
    NumTags = GetInt()
    ReDim TagsInfo(NumTags) As TIFFTAG
    Lst_Info.AddItem "Number" & Chr$(9) & ": " & Format$(NumTags)
    For I = 1 To NumTags
    Tag = GetInt()
    Typ = GetInt()
    Length = GetLng()
    Offset = GetLng()
    TagsInfo(I).Tag = Tag
    TagsInfo(I).Type = Typ
    TagsInfo(I).Length = Length
    TagsInfo(I).Offset = Offset
    Next I
    For I = 1 To NumTags
    If TagsInfo(I).Tag <= 532 Then Lst_Info.AddItem "Tag" & Chr$(9) & ": " & Tags(TagsInfo(I).Tag)
    A$ = ""
    Select Case TagsInfo(I).Type
    Case 1
    If TagsInfo(I).Length <= 1 Then
        A$ = Format$(TagsInfo(I).Offset And &HF)
    Else
        A$ = "Offset = " & Format$(TagsInfo(I).Offset) & "  Length = " & Format$(TagsInfo(I).Length)
    End If
    Case 2
    Seek #Fi, TagsInfo(I).Offset + 1
    Do
    Get #Fi, , BT$
    If BT$ <> "" Then A$ = A$ & BT$
    Loop Until Asc(BT$) = 0
    Case 3
    If TagsInfo(I).Length <= 1 Then
        A$ = Format$(TagsInfo(I).Offset And &HFFF)
    Else
        A$ = "Offset = " & Format$(TagsInfo(I).Offset) & "  Length = " & Format$(TagsInfo(I).Length)
    End If
    Case 4
    If TagsInfo(I).Length <= 1 Then
        A$ = Format$(TagsInfo(I).Offset)
    Else
        A$ = "Offset = " & Format$(TagsInfo(I).Offset) & "  Length = " & Format$(TagsInfo(I).Length)
    End If
    Case 5
    Seek #Fi, TagsInfo(I).Offset + 1
    A$ = Str$(GetLng() / GetLng())
    End Select
    Lst_Info.AddItem "Type" & Chr$(9) & ": " & Typs(TagsInfo(I).Type - 1) & " = " & A$
    Next I
    Close
End Sub

Sub Info_WMF ()
    Dim WMFH As METAFILEHEADER
    Dim WMF As METAHEADER
    Dim A$

    Fi = FreeFile
    Open File$ For Binary As Fi
    Get #Fi, , WMFH
    If WMFH.key <> &H9AC6CDD7 Then Seek #Fi, 1
    Get #Fi, , WMF
    Close
    If WMFH.key = &H9AC6CDD7 Then
    Lst_Info.AddItem "File header found"
    Lst_Info.AddItem "Left" & Chr$(9) & ": " & Format$(WMFH.bbox.Left)
    Lst_Info.AddItem "Top" & Chr$(9) & ": " & Format$(WMFH.bbox.Top)
    Lst_Info.AddItem "Right" & Chr$(9) & ": " & Format$(WMFH.bbox.right)
    Lst_Info.AddItem "Bottom" & Chr$(9) & ": " & Format$(WMFH.bbox.Bottom)
    Lst_Info.AddItem "Units per inch" & Chr$(9) & ": " & Format$(WMFH.inch)
    End If
    A$ = "Unknown"
    If WMF.mtType = 1 Then A$ = "Memory metafile"
    If WMF.mtType = 2 Then A$ = "Disk metafile"
    Lst_Info.AddItem "Type" & Chr$(9) & ": " & A$
    Lst_Info.AddItem "Header size" & Chr$(9) & ": " & Format$(WMF.mtHeaderSize)
    A$ = "Unknown"
    If WMF.mtVersion = &H300 Then A$ = "Supports DIB format"
    If WMF.mtVersion = &H100 Then A$ = "No DIB support"
    Lst_Info.AddItem "Version" & Chr$(9) & ": " & A$
    Lst_Info.AddItem "Size" & Chr$(9) & ": " & Format$(WMF.mtSize)
    Lst_Info.AddItem "Number of objects" & Chr$(9) & ": " & Format$(WMF.mtNoObjects)
    Lst_Info.AddItem "Max record" & Chr$(9) & ": " & Format$(WMF.mtMaxRecord)
    Lst_Info.AddItem "Num. of parameters" & Chr$(9) & ": " & Format$(WMF.mtNoParameters)
End Sub

Sub Info_WPG ()
    Dim WPG As WPGHEAD
    Dim Typ, T&, I&, L&

    Fi = FreeFile
    IntMot = True
    Open File$ For Binary As Fi
    Get #Fi, , WPG
    Lst_Info.AddItem "ID" & Chr$(9) & ": " & Right$(WPG.ID, 3)
    Lst_Info.AddItem "First record offset" & Chr$(9) & ": " & Format$(WPG.Start)
    Lst_Info.AddItem "Product" & Chr$(9) & ": " & Format$(Asc(WPG.Product))
    Lst_Info.AddItem "File type" & Chr$(9) & ": " & Format$(Asc(WPG.FileType))
    Lst_Info.AddItem "Major Version" & Chr$(9) & ": " & Format$(Asc(WPG.MajorVersion))
    Lst_Info.AddItem "Minor Version" & Chr$(9) & ": " & Format$(Asc(WPG.MinorVersion))
    Lst_Info.AddItem "Encryption" & Chr$(9) & ": " & Format$(WPG.Encrypt)
    Lst_Info.AddItem "Reserved" & Chr$(9) & ": " & Format$(WPG.Reserved)
    Seek #Fi, WPG.Start + 1
    Do
    Typ = GetC()
    T = Seek(Fi)
    I = GetC()
    If I = 255 Then
        I = GetInt()
        If I And &H8000 Then
        L = (I And &H7FFF) * 2 ^ 16
        I = GetInt()
        L = L + I + 4
        Else
        L = I + 2
        End If
    Else
        L = I
    End If

    Select Case Typ
    Case 11
        Lst_Info.AddItem "Width" & Chr$(9) & ": " & Format$(GetInt())
        Lst_Info.AddItem "Height" & Chr$(9) & ": " & Format$(GetInt())
        Lst_Info.AddItem "Bits" & Chr$(9) & ": " & Format$(GetInt())
        Lst_Info.AddItem "Bitmap found"
        Found_BMP = True

    Case 14
        Lst_Info.AddItem "Color map found"

    End Select

    Seek #Fi, T + L + 1
    Loop While Seek(Fi) < LOF(Fi)
    Close
    If Found_BMP = False Then Lst_Info.AddItem "No Bitmap found"
End Sub

Sub Mnu_Close_Click ()
    Pic_Graphic.Visible = False
    Frame1.Visible = True
    Mnu_Close.Visible = False
    Ret = DoEvents()
    Hscroll1.Visible = False
    Vscroll1.Visible = False
    Picture2.Visible = False
    Ret = DoEvents()
End Sub

Function Next_Marker ()
    Dim C, Discarded_Bytes

    C = GetC()
    While C <> &HFF
    Discarded_Bytes = Discarded_Bytes + 1
    C = GetC()
    Wend
    Do
    C = GetC()
    Loop While C = &HFF
    If Discarded_Bytes <> 0 Then
    MsgBox "Garbage found in JPEG file", 48, "Graphics Viewer"
    Close Fi
    Next_Marker = -1
    Exit Function
    End If
    Next_Marker = C
End Function

Sub Picture2_Click ()
    Hscroll1.Value = Hscroll1.Max
    Vscroll1.Value = Vscroll1.Max
End Sub

Sub Picture2_DblClick ()
    Hscroll1.Value = 0
    Vscroll1.Value = 0
End Sub

Sub Process_COM ()
    Dim CH, Lastch, Length, A$

    Length = GetInt()
    If Length < 2 Then
    MsgBox "Errroneous JPEG marker length", 48, "Graphics Viewer"
    Close Fi
    Exit Sub
    End If
    Length = Length - 2
    While Length > 0
    CH = GetC()
    A$ = A$ & Chr$(CH)
    Length = Length - 1
    Wend
    MsgBox A$, 64, "JPEG Comment"
End Sub

Sub Process_SOFn (Marker)
    Dim Length, Image_Height, Image_Width, Data_Precision, Num_Components
    Dim Ci, C1, C2, C3
    Dim Process$

    Length = GetInt()
    Data_Precision = GetC()
    Image_Height = GetInt()
    Image_Width = GetInt()
    Num_Components = GetC()

    Select Case Marker
    Case M_SOF0
    Process = "Baseline"

    Case M_SOF1
    Process = "Extended sequential"

    Case M_SOF2
    Process = "Progressive"

    Case M_SOF3
    Process = "Lossless"

    Case M_SOF5
    Process = "Differential sequential"

    Case M_SOF6
    Process = "Differential progressive"

    Case M_SOF7
    Process = "Differential lossless"

    Case M_SOF9
    Process = "Extended sequential, arithmetic coding"

    Case M_SOF10
    Process = "Progressive, arithmetic coding"

    Case M_SOF11
    Process = "Lossless, arithmetic coding"

    Case M_SOF13
    Process = "Differential sequential, arithmetic coding"

    Case M_SOF14
    Process = "Differential progressive, arithmetic coding"

    Case M_SOF15
    Process = "Differential lossless, arithmetic coding"

    Case Else
    Process = "Unknown"

    End Select
    Lst_Info.AddItem "Process" & Chr$(9) & ": " & Process
    Lst_Info.AddItem "Width" & Chr$(9) & ": " & Format$(Image_Width)
    Lst_Info.AddItem "Height" & Chr$(9) & ": " & Format$(Image_Height)
    Lst_Info.AddItem "Color components" & Chr$(9) & ": " & Format$(Num_Components)
    Lst_Info.AddItem "Bits per sample" & Chr$(9) & ": " & Format$(Data_Precision)
    If Length <> 8 + Num_Components * 3 Then
    MsgBox "Bogus SOF marker length", 48, "Graphics Viewer"
    Close Fi
    Canc = True
    Exit Sub
    End If
    For Ci = 0 To Num_Components - 1
    C1 = GetC()
    C2 = GetC()
    C3 = GetC()
    Next Ci
End Sub

Sub Skip_Variable ()
    Dim Length, T

    Length = GetInt()
    If Length < 2 Then
    MsgBox "Errroneous JPEG marker length", 48, "Graphics Viewer"
    Close Fi
    Exit Sub
    End If
    Length = Length - 2
    Seek #Fi, Seek(Fi) + Length
End Sub

Sub VScroll1_Change ()
    PY = -Vscroll1.Value
    Pic_Graphic.Move PX, PY
End Sub